home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / htmlCustom.tcl < prev    next >
Text File  |  1999-04-24  |  45KB  |  1,235 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlCustom.tcl"
  6.  #                                    created: 96-06-29 21.36.50 
  7.  #                                last update: 99-04-24 13.19.09 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4
  13.  # 
  14.  # Copyright 1996-1999 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlDisabled {} {
  25.     alertnote "Disabled function!"
  26.     error "Disabled function!"
  27. }
  28.  
  29. #
  30. # Defining new HTML elements.
  31. #
  32. proc htmlNewElement {} {
  33.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemAttrUsed
  34.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  35.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins
  36.     global HTMLmodeVars specURL specColor specWindow htmlSpecURL htmlSpecColor htmlSpecWindow
  37.     global htmlVersion htmlShownWarning htmlAdditionExist cssModeIsLoaded
  38.     
  39.     if {[info exists htmlShownWarning]} {htmlDisabled}
  40.     set invalidInput 1
  41.     set values {"" 1 1 0 0}
  42.     while {$invalidInput} {
  43.         set box "-t {New element} 10 10 100 25 -e [list [lindex $values 0]] 110 10 250 25 \
  44.         -c {Has closing tag} [lindex $values 1] 10 40 150 55 \
  45.         -t {Element type} 10 80 100 95 -r Normal [lindex $values 2] 10 100 100 115 \
  46.         -r {INPUT element with TYPE given above} [lindex $values 3] 10 120 300 135 \
  47.         -r {Plug-in} [lindex $values 4] 10 140 100 155 \
  48.         -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  49.         set values [eval [concat dialog -w 340 -h 200 $box]]
  50.         if {[lindex $values 6]} {return}
  51.         set element [string toupper [string trim [lindex $values 0]]]
  52.         set closingTag [lindex $values 1]
  53.         if {[lindex $values 2]} {
  54.             set elemType normal
  55.         } elseif {[lindex $values 3]} {
  56.             set elemType input
  57.         } else {
  58.             set elemType plugin
  59.         }
  60.         # Check that input is ok.
  61.         if {![string length $element]} {
  62.             alertnote "You must specify the element."
  63.         } elseif {[info exists htmlElemAttrOptional1($element)]} {
  64.             alertnote "The element $element is already defined."
  65.             return
  66.         } elseif {![regexp {^[-_a-zA-Z0-9]+$} $element]} {
  67.             alertnote "Invalid characters in element name. For example, it may not contain spaces."
  68.         } else {
  69.             set invalidInput 0
  70.         }
  71.     }
  72.  
  73.     # Get a key binding.
  74.     if {[catch {dialog::getAKey $element ""} keyStr]} {return}
  75.     
  76.     # Get the attributes    
  77.     set allattributes [htmlGetCustomAttrs $element {}]
  78.     if {![string length $allattributes]} {return}
  79.     set optional [lindex $allattributes 0]
  80.     set AttrRequired [lindex $allattributes 1]
  81.     set AttrNumber [lindex $allattributes 2]
  82.     set AttrChoices [lindex $allattributes 3]
  83.     set EventHandler [lindex $allattributes 4]
  84.     set URL [lindex $allattributes 5]
  85.     set Color [lindex $allattributes 6]
  86.     set Window [lindex $allattributes 7]
  87.     # Get the layout.
  88.     if {$elemType != "normal" || !$closingTag} {
  89.         set customproc [htmlSetCustProc1 {0 0} $elemType $element]
  90.     } else {
  91.         set customproc [htmlSetCustProc2 {1 0 0 0} $element]
  92.     }
  93.     if {![string length $customproc]} {return}
  94.     
  95.     # Save the element
  96.     message "Saving new element…"
  97.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  98.     if {![file exists $PREFS]} {mkdir $PREFS}
  99.     set fid [open $PREFS:HTMLadditions.tcl a+]
  100.     if {!$isfile} {puts $fid $htmlVersion}
  101.     puts $fid "$element \{set htmlElemKeyBinding($element) [list $keyStr]\}"
  102.     set htmlElemKeyBinding($element) $keyStr
  103.     htmlDeleteCache "CSS keybindings cache"
  104.     if {[info exists cssModeIsLoaded]} {cssBindOneKey $keyStr $element}
  105.     puts $fid "$element \{set htmlElemProc($element) [list $customproc]\}"
  106.     set htmlElemProc($element) $customproc
  107.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler] {
  108.         if {[llength [set $rcne]]} {
  109.             puts $fid "$element \{set htmlElem${rcne}1($element) [list [set $rcne]]\}"
  110.             set htmlElem${rcne}1($element) [set $rcne]
  111.         }
  112.     }
  113.     # Remove possible old versions of htmlElemAttrUsed
  114.     if {[info exists htmlElemAttrUsed($element)]} {
  115.         unset htmlElemAttrUsed($element)
  116.         removeArrDef htmlElemAttrUsed $element
  117.     }
  118.     
  119.     puts $fid "$element \{set htmlElemAttrOptional1($element) [list $optional]\}"
  120.     set htmlElemAttrOptional1($element) $optional
  121.     foreach ucw [list URL Color Window] {
  122.         if {[llength [set $ucw]]} {
  123.             foreach a [set $ucw] {
  124.                 puts $fid "$element \{lappend html${ucw}Attr $a\}"
  125.                 lappend html${ucw}Attr $a
  126.             }
  127.         }
  128.     }
  129.     if {$elemType == "plugin"} {
  130.         puts $fid "$element \{lappend htmlPlugins $element\}"
  131.         lappend htmlPlugins $element
  132.     }
  133.     foreach ucw [list URL Color Window] {
  134.         if {[llength [set spec$ucw]]} {
  135.             puts $fid "$element \{lappend htmlSpec$ucw [set spec$ucw]\}"
  136.             append htmlSpec$ucw " " [set spec$ucw]
  137.         }
  138.     }
  139.     close $fid
  140.     
  141.     set htmlAdditionExist 1
  142.     htmlRebuildMenu "Inserting new element in menu…"
  143.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  144.     if {!$HTMLmodeVars(simpleColoring)} {
  145.         regModeKeywords -a -k $HTMLmodeVars(tagColor) HTML [concat "<$element" "/$element"]
  146.         regModeKeywords -a -k $HTMLmodeVars(attributeColor) HTML [concat $AttrRequired $optional]
  147.     }
  148.     message "Done."
  149.     if {[llength $optional]} {htmlUseAttributes2 $element}
  150.     unset specURL
  151.     unset specColor
  152.     unset specWindow
  153. }
  154.  
  155. # Get attributes to custom element.
  156. proc htmlGetCustomAttrs {element allattrs {nomore 1}} {
  157.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  158.     global specURL specColor specWindow
  159.     
  160.     set allHTMLattrs [htmlGetAllAttrs]
  161.     set optional {}
  162.     set AttrRequired {}
  163.     set AttrChoices {}
  164.     set AttrNumber {}
  165.     set EventHandler {}
  166.     set URL {}
  167.     set Color {}
  168.     set Window {}
  169.     set specURL {}
  170.     set specColor {}
  171.     set specWindow {}
  172.     set i 0
  173.     set dispAttr $allattrs
  174.     
  175.     while {1} {
  176.         incr i
  177.         if {[catch {htmlCustomInpAttr $element $i $dispAttr $nomore} attribute]} {
  178.             if {$attribute != "Remove last!"} {return}
  179.             set toremove [lindex $dispAttr [expr [llength $dispAttr] - 1]]
  180.             set dispAttr [lreplace $dispAttr [expr [llength $dispAttr] - 1] [expr [llength $dispAttr] - 1]]
  181.             set allattrs [lreplace $allattrs [expr [llength $allattrs] - 1] [expr [llength $allattrs] - 1]]
  182.             set elemrm [lindex $toremove 0]
  183.             if {[lindex $toremove 1] == "(Flag)"} {
  184.                 if {[set ind [lsearch -exact $AttrRequired $elemrm]] >=0} {
  185.                     set AttrRequired [lreplace $AttrRequired $ind $ind]
  186.                 } elseif {[set ind [lsearch -exact $optional $elemrm]] >=0} {
  187.                     set optional [lreplace $optional $ind $ind]
  188.                 }
  189.             } else {
  190.                 foreach l [list optional AttrRequired AttrChoices AttrNumber EventHandler URL Color Window] {
  191.                     set tmp {}
  192.                     foreach m [set $l] {
  193.                         if {![string match "${elemrm}=*" $m]} {
  194.                             lappend tmp $m
  195.                         }
  196.                     }
  197.                     set $l $tmp
  198.                 }
  199.             }
  200.             foreach l [list URL Color Window] {
  201.                 if {[set where [lsearch -exact [set spec$l] "${element}=[string trimright $elemrm =]"]] >= 0 || \
  202.                 [set where [lsearch -exact [set spec$l] "${element}!=[string trimright $elemrm =]"]] >= 0} {
  203.                     set spec$l [lreplace [set spec$l] $where $where]
  204.                 }
  205.             }
  206.             incr i -2
  207.             continue
  208.         }
  209.         if {![string length $attribute]} {break}
  210.         if {[lsearch -exact [string toupper $allattrs] [string toupper [lindex $attribute 0]]] >= 0} {
  211.             alertnote "$element already has an attribute '[lindex $attribute 0]'."
  212.             incr i -1
  213.         } else {
  214.             if {[catch {htmlCustomAttrFix $element [lindex $attribute 0] \
  215.             [lindex $attribute 1] $allHTMLattrs} thisattr]} {
  216.                 incr i -1 
  217.                 continue
  218.             }
  219.             lappend allattrs [string trimright [lindex $thisattr 0] =]
  220.             set attr [lindex $thisattr 0]
  221.             set thistype [lindex $thisattr 1]
  222.             if {[lindex $attribute 2]} {
  223.                 lappend AttrRequired $attr
  224.             } elseif {$thistype != "Event handler"} {
  225.                 lappend optional $attr
  226.             } else {
  227.                 lappend EventHandler $attr
  228.             }
  229.             set attrext [expr ([lsearch -exact $allHTMLattrs $attr] >= 0 || [lsearch -exact $allHTMLattrs [string trimright $attr =]] >= 0)]
  230.             if {$thistype == "Choices"} {
  231.                 foreach c [lindex $thisattr 2] {
  232.                     lappend AttrChoices "$attr$c"
  233.                 }
  234.             } elseif {$thistype == "Number"} {
  235.                 lappend AttrNumber "$attr[lindex $thisattr 2]"
  236.             } elseif {$thistype == "URL" && [lsearch -exact $htmlURLAttr $attr] < 0 && !$attrext} {
  237.                 lappend URL $attr
  238.             } elseif {$thistype == "Color" && [lsearch -exact $htmlColorAttr $attr] < 0 && !$attrext} {
  239.                 lappend Color $attr
  240.             } elseif {$thistype == "Window" && [lsearch -exact $htmlWindowAttr $attr] < 0 && !$attrext} {
  241.                 lappend Window $attr
  242.             }
  243.             lappend dispAttr "[string trimright $attr =] (${thistype})"
  244.         }
  245.     }
  246.     return [list $optional $AttrRequired $AttrNumber $AttrChoices $EventHandler $URL $Color $Window]
  247. }
  248.  
  249. # Dialog for giving a new attribute.
  250. proc htmlCustomInpAttr {element num allattrs nomore} {
  251.     set typeList [list Other Number Choices Flag URL Color Window {Event handler}]
  252.     set values {0 0 {} Other 0}
  253.     set invalidInput 1
  254.     while {$invalidInput} {
  255.         set box "-t {Attribute $num for $element} 10 10 330 25 \
  256.         -e [list [lindex $values 2]] 10 40 150 55 \
  257.         -t Type: 170 40 205 55 \
  258.         -m [list [concat [list [lindex $values 3]] $typeList]] \
  259.         210 40 330 55 -c Required [lindex $values 4] 10 70 130 85"
  260.          if {$num > 1} {append box " -b {Remove last} 340 100 450 120"}
  261.          if {$nomore || $num > 1} {append box " -b {No more attributes} 340 70 480 90"}
  262.         set wi 10
  263.         set ht 120
  264.         if {[llength $allattrs]} {
  265.             append box " -t {All attributes} 10 100 200 115"
  266.             foreach ch $allattrs {
  267.                 append box " -t [list $ch] $wi $ht [expr $wi + 195] [expr $ht + 15]"
  268.                 incr wi 200
  269.                 if {$wi == 410} {
  270.                     set wi 10
  271.                     incr ht 20
  272.                 }
  273.             }
  274.         }
  275.         if {$wi == 210} {incr ht 20}
  276.         if {$ht < 130} {set ht 130}
  277.         set values [eval [concat dialog -w 490 -h $ht \
  278.         -b OK 340 10 405 30 -b Cancel 340 40 405 60 $box]]
  279.         if {[lindex $values 1]} {
  280.             error "Cancel"
  281.         } elseif {$num > 1 && [lindex $values 5]} {
  282.             error "Remove last!"
  283.         } elseif {[lindex $values 0]} {
  284.             set thisattr [string trim [lindex $values 2]]
  285.             set thistype [lindex $values 3]
  286.             if {$thistype != "Event handler"} {set thisattr [string toupper $thisattr]}
  287.             set required [lindex $values 4]
  288.             if {![regexp {^[-_a-zA-Z0-9]*$} $thisattr]} {
  289.                 alertnote "Invalid characters in attribute. For example, it may not contain spaces."
  290.             } elseif {[string length $thisattr]} {
  291.                 if {$required && $thistype == "Event handler"} {
  292.                     alertnote "Event handlers cannot be required attributes. It will be optional."
  293.                     set required 0
  294.                 }
  295.                 set invalidInput 0
  296.             }
  297.         } else {
  298.             return
  299.         }
  300.     }
  301.  
  302.     return [list $thisattr $thistype $required]
  303. }
  304.  
  305. # Dialogs to give more info about new attributes.
  306. proc htmlCustomAttrFix {element attr type allHTMLattrs {allchoices ""}} {
  307.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  308.     global specURL specColor specWindow
  309.  
  310.     # Check for special case with URL etc. if not called from htmlCustomNewChoice 
  311.     # (then allchoices has length >0)
  312.     foreach ucw [list URL Color Window] {
  313.         if {[lsearch -exact [set html${ucw}Attr] "$attr="] >= 0 && $type != $ucw && ![llength $allchoices]} {
  314.             lappend spec$ucw "$element!=$attr"
  315.         }
  316.     }
  317.     
  318.     switch $type {
  319.         Other {return [list "$attr=" $type]}
  320.         Number {
  321.             set values {0 0 0 {} 0}
  322.             while {1} {
  323.                 set box "-t {Range for $attr} 60 10 290 25 -t {Minvalue:} 10 40 100 55 \
  324.                 -e [list [lindex $values 2]] 110 40 130 55 -t {Maxvalue:} 150 40 240 55 \
  325.                 -e [list [lindex $values 3]] 250 40 270 55 -c {Value may be given in percent} \
  326.                 [lindex $values 4] 10 65 250 80"
  327.                 set values [eval [concat dialog -w 300 -h 120 \
  328.                 -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  329.                 set min [string trim [lindex $values 2]]
  330.                 set max [string trim [lindex $values 3]]
  331.                 set percent [lindex $values 4]
  332.                 if {[lindex $values 1]} {
  333.                     error "Cancel"
  334.                 } elseif {[lindex $values 0]} {
  335.                     if {![htmlIsInteger $min]} {
  336.                         alertnote "A minimum value must be specified."
  337.                     } elseif {[string length $max] && ![htmlIsInteger $max]} {
  338.                         alertnote "Not a valid number for maximum value."
  339.                     } elseif {[string length $max] && $max < $min} {
  340.                         alertnote "Maxvalue is smaller than minvalue."
  341.                     } else {
  342.                         break
  343.                     }
  344.                 }
  345.             }
  346.             set number "$min:"
  347.             if {[string length $max]} {
  348.                 append number "$max:"
  349.             } else {
  350.                 append number "i:"
  351.             }
  352.             if {$percent} {
  353.                 append number "%"
  354.             } else {
  355.                 append number "n"
  356.             }
  357.             return [list "$attr=" $type $number]
  358.         }
  359.         Choices {
  360.             set i 0
  361.             set choices {}
  362.             while {1} {
  363.                 incr i
  364.                 set values {0 0 {}}
  365.                 set invalidInput 1
  366.                 while {$invalidInput} {
  367.                     set box "-t {Choice $i for $attr} 10 10 210 25 \
  368.                     -e [list [lindex $values 2]] 10 40 200 55"
  369.                     if {$i > 1} {append box " -b {No more choices} 220 70 340 90 -b {Remove last} 220 100 340 120"}
  370.                     set wi 10
  371.                     set ht 90
  372.                     if {[llength $allchoices]} {
  373.                         append box " -t {All choices} 10 70 200 85"
  374.                         foreach ch $allchoices {
  375.                             append box " -t $ch $wi $ht [expr $wi + 95] [expr $ht + 15]"
  376.                             incr wi 100
  377.                             if {$wi == 210} {
  378.                                 set wi 10
  379.                                 incr ht 20
  380.                             }
  381.                         }
  382.                     }
  383.                     if {$wi == 110} {incr ht 20}
  384.                     if {$ht < 130} {set ht 130}
  385.                     set values [eval [concat dialog -w 350 -h $ht \
  386.                     -b OK 220 10 285 30 -b Cancel 220 40 285 60 \
  387.                     $box]]
  388.                     if {[lindex $values 1]} {
  389.                         error "Cancel"
  390.                     } elseif {$i > 1 && [lindex $values 3] } {
  391.                         return [list "$attr=" $type $choices]
  392.                     } elseif {$i > 1 && [lindex $values 4]} {
  393.                         incr i -1
  394.                         set choices [lreplace $choices [expr [llength $choices] - 1] [expr [llength $choices] - 1]]
  395.                         set allchoices [lreplace $allchoices [expr [llength $allchoices] - 1] [expr [llength $allchoices] - 1]]
  396.                     } elseif {[lindex $values 0]} {
  397.                         set thischoice [string toupper [string trim [lindex $values 2]]]
  398.                         if {![regexp {^[-_a-zA-Z0-9\.]*$} $thischoice]} {
  399.                             alertnote "Invalid characters in choice.  For example, it may not contain spaces."
  400.                         } elseif {[string length $thischoice]} {
  401.                             if {[lsearch -exact $allchoices $thischoice] >=0 } {
  402.                                 alertnote "$attr already has a choice '$thischoice'."
  403.                             } else {
  404.                                 set invalidInput 0
  405.                             }
  406.                         }
  407.                     }
  408.                 }
  409.                 lappend choices $thischoice
  410.                 lappend allchoices $thischoice
  411.             }
  412.         }
  413.         Flag {return [list $attr $type]}
  414.         URL {
  415.             if {[lsearch -exact $htmlURLAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  416.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  417.                 lappend specURL "${element}=$attr"
  418.             }
  419.             return [list "$attr=" $type]
  420.         }
  421.         Color {
  422.             if {[lsearch -exact $htmlColorAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  423.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  424.                 lappend specColor "${element}=$attr"
  425.             }
  426.             return [list "$attr=" $type]
  427.         }
  428.         Window {
  429.             if {[lsearch -exact $htmlWindowAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  430.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  431.                 lappend specWindow "${element}=$attr"
  432.             }
  433.             return [list "$attr=" $type]
  434.         }
  435.         "Event handler" {
  436.             return [list "$attr=" $type]
  437.         }
  438.     }
  439.     
  440. }
  441.  
  442. proc htmlSetCustProc1 {values elemType element} {
  443.     set box "-t {Layout} 80 10 180 25 \
  444.     -c {Always a new line before tag.} [lindex $values 0] 10 40 225 55 \
  445.     -c {Always a new line after tag.} [lindex $values 1] 10 60 225 75 \
  446.     -b OK 20 90 85 110 -b Cancel 105 90 170 110"
  447.     set values [eval [concat dialog -w 230 -h 120 $box]]
  448.     if {[lindex $values 3]} {return}
  449.     switch $elemType {
  450.         normal {set  customproc "htmlBuildOpening $element"}
  451.         input {set customproc "htmlBuildInputElem $element"}
  452.         plugin {set customproc "htmlBuildOpening EMBED"}
  453.     }
  454.     lappend customproc [lindex $values 0] [lindex $values 1]
  455.     if {$elemType == "plugin"} {lappend customproc $element}
  456.     return $customproc
  457. }
  458.  
  459. proc htmlSetCustProc2 {values element} {
  460.     set box "-t {Layout} 80 10 180 25 \
  461.     -r {text<TAG>text</TAG>text} [lindex $values 0] 10 40 200 60 \
  462.     -r {text\r<TAG>text</TAG>\rtext} [lindex $values 1] 10 70 150 130 \
  463.     -r {blank line\r<TAG>text</TAG>\rblank line} [lindex $values 2] 10 140 150 200 \
  464.     -r {blank line\r<TAG>\rtext\r</TAG>\rblank line} [lindex $values 3] 10 210 150 310"
  465.     set values [eval [concat dialog -w 200 -h 350 \
  466.     -b OK 20 320 85 340 -b Cancel 105 320 170 340 $box]]
  467.     if {[lindex $values 1]} {return}
  468.     if {[lindex $values 2]} {set customproc "htmlBuildElem $element"}
  469.     if {[lindex $values 3]} {set customproc "htmlBuildCRElem $element"}
  470.     if {[lindex $values 4]} {set customproc "htmlBuildCRElem $element 1"}
  471.     if {[lindex $values 5]} {set customproc "htmlBuildCR2Elem $element"}
  472.     return $customproc
  473. }
  474.  
  475. # Add new attributes to an element.
  476. proc htmlNewAttributes {} {
  477.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemKeyBinding
  478.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  479.     global htmlElemEventHandler1 HTMLmodeVars htmlSpecURL htmlSpecColor htmlSpecWindow
  480.     global specURL specColor specWindow htmlVersion htmlShownWarning htmlAdditionExist
  481.     
  482.     if {[info exists htmlShownWarning]} {htmlDisabled}
  483.     
  484.     if {[catch {listpick -p "Select element to add attributes to." \
  485.     [lsort [array names htmlElemAttrOptional1]]} element] || \
  486.     ![string length $element]} {return}
  487.     set allattrs {}
  488.     foreach e [htmlGetRequired $element] {
  489.         lappend allattrs [string trimright $e =]
  490.     }
  491.     foreach e [htmlGetOptional $element 1] {
  492.         lappend allattrs [string trimright $e =]
  493.     } 
  494.     set attributes [htmlGetCustomAttrs $element $allattrs 0]
  495.     if {![string length [join $attributes ""]]} {return}
  496.     set AttrOptional [lindex $attributes 0]
  497.     set AttrRequired [lindex $attributes 1]
  498.     set AttrNumber [lindex $attributes 2]
  499.     set AttrChoices [lindex $attributes 3]
  500.     set EventHandler [lindex $attributes 4]
  501.     set URL [lindex $attributes 5]
  502.     set Color [lindex $attributes 6]
  503.     set Window [lindex $attributes 7]
  504.     
  505.     if {[regexp { } $element]} {
  506.         set arg "\[list $element\]"
  507.     } else {
  508.         set arg $element
  509.     }
  510.     
  511.     # Save the element
  512.     message "Saving new attributes…"
  513.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  514.     if {![file exists $PREFS]} {mkdir $PREFS}
  515.     set fid [open $PREFS:HTMLadditions.tcl a+]
  516.     if {!$isfile} {puts $fid $htmlVersion}
  517.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler AttrOptional] {
  518.         if {[string length [set $rcne]]} {
  519.             puts $fid "[list $element] \{lappend htmlElem${rcne}1($arg) [set $rcne]\}"
  520.             append htmlElem${rcne}1($element) " " [set $rcne]
  521.         }
  522.     }
  523.     foreach ucw [list URL Color Window] {
  524.         if {[string length [set $ucw]]} {
  525.             foreach a [set $ucw] {
  526.                 puts $fid "[list $element] \{lappend html${ucw}Attr $a\}"
  527.                 lappend html${ucw}Attr $a
  528.             }
  529.         }
  530.     }
  531.     foreach ucw [list URL Color Window] {
  532.         if {[llength [set spec$ucw]]} {
  533.             puts $fid "[list $element] \{lappend htmlSpec$ucw [set spec$ucw]\}"
  534.             append htmlSpec$ucw " " [set spec$ucw]
  535.         }
  536.     }
  537.     close $fid
  538.     set htmlAdditionExist 1
  539.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  540.     if {!$HTMLmodeVars(simpleColoring)} {
  541.         regModeKeywords -a -k $HTMLmodeVars(attributeColor) \
  542.         HTML [concat $AttrRequired $AttrOptional]    
  543.     }
  544.     unset specURL
  545.     unset specColor
  546.     unset specWindow
  547.     message "Done."
  548.     if {[llength [htmlGetOptional $element 1]]} {htmlUseAttributes2 $element}
  549. }
  550.  
  551. # Add new choices to an attribute with predefined choices.
  552. proc htmlNewChoices {} {
  553.     global htmlElemAttrChoices1 PREFS htmlVersion htmlShownWarning htmlAdditionExist
  554.     global htmlElemKeyBinding
  555.     
  556.     if {[info exists htmlShownWarning]} {htmlDisabled}
  557.  
  558.     if {[catch {listpick -p "Select element to add choices to." \
  559.     [lsort [array names htmlElemAttrChoices1]]} element] || \
  560.     ![string length $element]} {return}
  561.     set choiceatts ""
  562.     foreach e $htmlElemAttrChoices1($element) {
  563.         regexp {[^=]*} $e attr
  564.         if {[lsearch $choiceatts $attr] < 0} {lappend choiceatts $attr}
  565.     }
  566.     if {[catch {listpick -p "Select attribute to add choices to." [lsort $choiceatts]} attr] || \
  567.     ![string length $attr]} {return}
  568.     foreach c $htmlElemAttrChoices1($element) {
  569.         if {[string match "${attr}=*" $c]} {
  570.             lappend allchoices [string range $c [expr [string length $attr] + 1] end]
  571.         }    
  572.     }
  573.     
  574.     set newchoices [htmlCustomAttrFix $element $attr Choices [htmlGetAllAttrs] $allchoices]
  575.     foreach c [lindex $newchoices 2] {
  576.         lappend choices "${attr}=$c"
  577.     }
  578.     
  579.     if {[regexp { } $element]} {
  580.         set arg "\[list $element\]"
  581.     } else {
  582.         set arg $element
  583.     }
  584.     # Save the choices
  585.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  586.     if {![file exists $PREFS]} {mkdir $PREFS}
  587.     set fid [open $PREFS:HTMLadditions.tcl a+]
  588.     if {!$isfile} {puts $fid $htmlVersion}
  589.     puts $fid "[list $element] \{lappend htmlElemAttrChoices1($arg) $choices\}"
  590.     append htmlElemAttrChoices1($element) " " $choices
  591.     close $fid
  592.     set htmlAdditionExist 1
  593.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  594.     message "New choices saved."
  595. }
  596.  
  597. #
  598. # Change key binding for a custom element.
  599. #
  600. proc htmlChangeKeyBinding {} {
  601.     global htmlElemKeyBinding PREFS htmlShownWarning cssModeIsLoaded
  602.     
  603.     if {[info exists htmlShownWarning]} {htmlDisabled}
  604.  
  605.     if {![info exists htmlElemKeyBinding]} {
  606.         alertnote "No custom elements are defined."
  607.         return
  608.     }
  609.     if {[catch {listpick -p "Select element to change key binding for." \
  610.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  611.     if {[catch {dialog::getAKey $elem $htmlElemKeyBinding($elem)} keyStr]} {return}
  612.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  613.         alertnote "Cannot find 'HTMLadditions.tcl'. Key binding cannot be changed."
  614.         return
  615.     }
  616.     set fid [open $PREFS:HTMLadditions.tcl r]
  617.     set filecont [string trimright [read $fid] "\n"]
  618.     close $fid
  619.     foreach line [split $filecont "\n"] {
  620.         if {[lindex $line 0] == $elem && [regexp {htmlElemKeyBinding} $line]} {
  621.             append newlines "$elem \{set htmlElemKeyBinding($elem) [list $keyStr]\}\n"
  622.         } else {
  623.             append newlines "$line\n"
  624.         }
  625.     }
  626.     set fid [open $PREFS:HTMLadditions.tcl w]
  627.     puts -nonewline $fid $newlines
  628.     close $fid
  629.     htmlDeleteCache "CSS keybindings cache"
  630.     if {[info exists cssModeIsLoaded]} {
  631.         cssBindOneKey $htmlElemKeyBinding($elem) $elem un
  632.         cssBindOneKey $keyStr $elem
  633.     }
  634.     set htmlElemKeyBinding($elem) $keyStr
  635.     htmlRebuildMenu "Redefining key binding…"
  636.     message "Done."
  637. }
  638.  
  639. #
  640. # Change type and layout for a custom element.
  641. #
  642. proc htmlChangeTypeandLayout {} {
  643.     global htmlElemKeyBinding htmlElemProc PREFS htmlPlugins htmlShownWarning
  644.     
  645.     if {[info exists htmlShownWarning]} {htmlDisabled}
  646.  
  647.     if {![info exists htmlElemKeyBinding]} {
  648.         alertnote "No custom elements are defined."
  649.         return
  650.     }
  651.     if {[catch {listpick -p "Select element to change type and layout for." \
  652.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  653.     set eproc $htmlElemProc($elem)
  654.     set proctype [lindex $eproc 0]
  655.     if {$proctype == "htmlBuildOpening" || $proctype == "htmlBuildInputElem"} {
  656.         if {[lindex $eproc 1] == "EMBED"} {
  657.             set type plugin
  658.         } else {
  659.             set type normal
  660.         }
  661.         if {$proctype == "htmlBuildInputElem"} {set type input}
  662.         set closing 0
  663.         set values "[lindex $eproc 2] [lindex $eproc 3]"
  664.     } else {
  665.         set type normal
  666.         set closing 1
  667.         if {$proctype == "htmlBuildElem"} {set values {1 0 0 0}}
  668.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 2} {set values {0 1 0 0}}
  669.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 3} {set values {0 0 1 0}}
  670.         if {$proctype == "htmlBuildCR2Elem"} {set values {0 0 0 1}}
  671.     }
  672.     set box "-t $elem 100 10 300 25 \
  673.     -c {Has closing tag} $closing 10 40 150 55 \
  674.     -t {Element type} 10 80 100 95 -r Normal [regexp {normal} $type] 10 100 100 115 \
  675.     -r {INPUT element with TYPE given above} [regexp {input} $type] 10 120 300 135 \
  676.     -r {Plug-in} [regexp {plugin} $type] 10 140 100 155 \
  677.     -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  678.     set typeval [eval [concat dialog -w 310 -h 200 $box]]
  679.     if {[lindex $typeval 5]} {return}
  680.     set newclosing [lindex $typeval 0]
  681.     if {[lindex $typeval 1]} {set newtype normal}
  682.     if {[lindex $typeval 2]} {set newtype input; set newclosing 0}
  683.     if {[lindex $typeval 3]} {set newtype plugin; set newclosing 0}
  684.  
  685.     if {$newclosing} {
  686.         if {$newclosing != $closing} {set values {1 0 0 0}}
  687.         set customproc [htmlSetCustProc2 $values $elem]
  688.     } else {
  689.         if {$newclosing != $closing} {set values {0 0}}
  690.         set customproc [htmlSetCustProc1 $values $newtype $elem]
  691.     }
  692.     if {![string length $customproc]} {return}
  693.     
  694.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  695.         alertnote "Cannot find 'HTMLadditions.tcl'. Type and layout cannot be changed."
  696.         return
  697.     }
  698.     set fid [open $PREFS:HTMLadditions.tcl r]
  699.     set filecont [string trimright [read $fid] "\n"]
  700.     close $fid
  701.     foreach line [split $filecont "\n"] {
  702.         if {[lindex $line 0] == $elem && [regexp {htmlElemProc} $line]} {
  703.             append newlines "$elem \{set htmlElemProc($elem) [list $customproc]\}\n"
  704.         } elseif {$type == "plugin" && $newtype != "plugin" && [lindex $line 0] == $elem && \
  705.         [regexp {htmlPlugins} $line]} {
  706.             set where [lsearch -exact $htmlPlugins $elem]
  707.             set htmlPlugins [lreplace $htmlPlugins $where $where]
  708.         } else {
  709.             append newlines "$line\n"
  710.         }
  711.     }
  712.     if {$newtype == "plugin" && $type != "plugin"} {
  713.         lappend htmlPlugins $elem
  714.         append newlines "$elem \{lappend htmlPlugins $elem\}\n"
  715.     }
  716.     set fid [open $PREFS:HTMLadditions.tcl w]
  717.     puts -nonewline $fid $newlines
  718.     close $fid
  719.     set htmlElemProc($elem) $customproc
  720.     message "Type and layout redefined."
  721. }
  722.  
  723. # Remove custom element ot additions to an element.
  724. proc htmlRemoveAdditions {} {
  725.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr cssModeIsLoaded
  726.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  727.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins
  728.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning htmlAdditionExist
  729.     
  730.     if {[info exists htmlShownWarning]} {htmlDisabled}
  731.     
  732.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  733.         if {[info exists htmlElemKeyBinding]} {
  734.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  735.         } else {
  736.             alertnote "No custom additions has been made."
  737.         }
  738.         return
  739.     }
  740.     set fid [open $PREFS:HTMLadditions.tcl r]
  741.     set additions [string trimright [read $fid] "\n"]
  742.     close $fid
  743.     set elems ""
  744.     foreach line [lrange [split $additions "\n"] 1 end] {
  745.         set element [lindex $line 0]
  746.         if {[lsearch -exact $elems $element] < 0} {lappend elems $element}
  747.     }
  748.     if {[catch {listpick -p "Select element to remove additions from." [lsort $elems]} element] || \
  749.     ![string length $element] || [askyesno "Remove additions from $element?"] == "no"} {return}
  750.     
  751.  
  752.     message "Removing additions to $element…"
  753.     set isNewElem [info exists htmlElemKeyBinding($element)]
  754.     # If new element, unset all its variables.
  755.     if {$isNewElem} {
  756.         catch {unset htmlElemAttrRequired1($element)}
  757.         catch {unset htmlElemAttrChoices1($element)}
  758.         catch {unset htmlElemAttrNumber1($element)}
  759.         catch {unset htmlElemAttrOptional1($element)}
  760.         catch {unset htmlElemEventHandler1($element)}
  761.         if {[info exists cssModeIsLoaded]} {
  762.             cssBindOneKey $htmlElemKeyBinding($element) $element un
  763.         }
  764.         set tmpkey $htmlElemKeyBinding($element)
  765.         catch {unset htmlElemKeyBinding($element)}
  766.         catch {unset htmlElemProc($element)}
  767.         set isPlugin [lsearch -exact $htmlPlugins $element]
  768.         if {$isPlugin >=0 } {set htmlPlugins [lreplace $htmlPlugins $isPlugin $isPlugin]}
  769.         if {![llength [array names htmlElemKeyBinding]]} {
  770.             catch {unset htmlElemKeyBinding}
  771.             if {[string length $tmpkey]} {
  772.                 set key [string tolower [string range $tmpkey [expr [string length $tmpkey] - 1] end]]
  773.                 set mods ""
  774.                 foreach m [split [string range $tmpkey 1 [expr [string length $tmpkey] - 3]] < ] {
  775.                     if {$m == "B"} {append mods z}
  776.                     if {$m == "I"} {append mods o}
  777.                     if {$m == "U"} {append mods s}
  778.                     if {$m == "O"} {append mods c}
  779.                 }
  780.                 catch {unbind '$key' <$mods> {} HTML}
  781.             }
  782.         }
  783.         if {![llength [array names htmlElemProc]]} {catch {unset htmlElemProc}}
  784.     }
  785.     set newlines ""
  786.     foreach line [lrange [split $additions "\n"] 1 end] {
  787.         set command [lindex $line 1]
  788.         if {[lindex $line 0] != $element} {
  789.             append newlines "$line\n"
  790.         } elseif {[lindex $command 0] == "lappend"} {
  791.             set var [lindex $command 1]
  792.             # Remove from URL, Color and Window lists.
  793.             foreach ucw [list URL Color Window] {
  794.                 if {$var == "html${ucw}Attr"} {
  795.                     lappend ${ucw}maybe [lindex $command 2]
  796.                     set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  797.                     set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  798.                 }
  799.                 if {$var == "htmlSpec${ucw}"} {
  800.                     foreach c [lrange $command 2 end] {
  801.                         set where [lsearch -exact [set htmlSpec${ucw}] $c]
  802.                         set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  803.                     }
  804.                 }
  805.             } 
  806.             # If added attribute to old element, remove attribute
  807.             if {!$isNewElem && $var != "htmlURLAttr" && $var != "htmlColorAttr" && \
  808.             $var != "htmlWindowAttr" && $var != "htmlSpecURL" && $var != "htmlSpecColor" && \
  809.             $var != "htmlSpecWindow"} {
  810.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  811.                 foreach c $added {
  812.                     set where [lsearch -exact [set ${var}($element)] $c]
  813.                     set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  814.                 }
  815.             }
  816.         }
  817.     }
  818.     # Unset empty lists for old variables.
  819.     if {!$isNewElem} {
  820.         foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  821.             if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  822.                 unset html${c}1($element)
  823.             }
  824.         }
  825.     }
  826.     # URL, Color or Window attributes just removed
  827.     # should be replaced if they are used by some other element.
  828.     foreach ucw [list URL Color Window] {
  829.         if {[info exists ${ucw}maybe]} {
  830.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  831.         }
  832.     }
  833.     if {[string length $newlines]} {
  834.         set fid [open $PREFS:HTMLadditions.tcl w]
  835.         puts -nonewline $fid "$htmlVersion\n$newlines"
  836.         close $fid
  837.     } else {
  838.         removeFile $PREFS:HTMLadditions.tcl
  839.         set htmlAdditionExist 0
  840.     }
  841.     htmlDeleteCache "CSS keybindings cache"
  842.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  843.     if {$isNewElem} {htmlRebuildMenu "Rebuilding HTML menu…"}
  844.     message "Done."
  845. }
  846.  
  847. proc htmlUCWmaybe {ucw maybe} {
  848.     global htmlElemAttrRequired1 htmlElemAttrOptional1 htmlSpecURL htmlSpecColor htmlSpecWindow
  849.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  850.     
  851.     set newlines ""
  852.     foreach m $maybe {
  853.         set foundit 0
  854.         foreach e [array names htmlElemAttrRequired1] {
  855.             if {[lsearch -exact $htmlElemAttrRequired1($e) $m] >= 0 && \
  856.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  857.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  858.                 lappend html${ucw}Attr $m
  859.                 set foundit 1
  860.                 break
  861.             } 
  862.         }
  863.         if {$foundit} {continue}
  864.         foreach e [array names htmlElemAttrOptional1] {
  865.             if {[lsearch -exact $htmlElemAttrOptional1($e) $m] >= 0 && \
  866.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  867.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  868.                 lappend html${ucw}Attr $m
  869.                 break
  870.             } 
  871.         }
  872.     }
  873.     return $newlines
  874. }
  875.  
  876. # Remove custom element ot additions to an element.
  877. proc htmlRemoveAttributes {} {
  878.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  879.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  880.     global htmlElemEventHandler1 htmlAdditionExist htmlElemKeyBinding
  881.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning
  882.     
  883.     if {[info exists htmlShownWarning]} {htmlDisabled}
  884.     
  885.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  886.         if {[info exists htmlElemKeyBinding]} {
  887.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  888.         } else {
  889.             alertnote "No custom additions has been made."
  890.         }
  891.         return
  892.     }
  893.     set fid [open $PREFS:HTMLadditions.tcl r]
  894.     set additions [string trimright [read $fid] "\n"]
  895.     close $fid
  896.     set elems ""
  897.     foreach line [lrange [split $additions "\n"] 1 end] {
  898.         set element [lindex $line 0]
  899.         if {[lsearch -exact $elems $element] < 0 && \
  900.         [llength [concat [htmlGetRequired $element] [htmlGetOptional $element 1]]]} {
  901.             lappend elems $element
  902.         }
  903.     }
  904.     if {[catch {listpick -p "Select element to remove attributes from." [lsort $elems]} element] || \
  905.     ![string length $element]} {return}
  906.     
  907.     set allatts {}
  908.     foreach line [lrange [split $additions "\n"] 1 end] {
  909.         set command [lindex $line 1]
  910.         if {[lindex $line 0] == $element} {
  911.             regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  912.             set added [string trimleft [string trimright $added \}] \{]
  913.             if {$var == "htmlElemAttrRequired1" || $var == "htmlElemAttrOptional1" || $var == "htmlElemEventHandler1"} {
  914.                 foreach c $added {
  915.                     if {[lsearch -exact $allatts [string trimright $c =]] < 0} {
  916.                         lappend allatts [string trimright $c =]
  917.                     }
  918.                 }
  919.             } elseif {$var == "htmlElemAttrChoices1"} {
  920.                 foreach c $added {
  921.                     regexp {[^=]+} $c tmp
  922.                     if {[lsearch -exact $allatts $tmp] < 0} {
  923.                         lappend allatts $tmp
  924.                     }
  925.                 }
  926.             }
  927.         }
  928.     }
  929.     
  930.     if {[catch {listpick -p "Select attributes to remove." -l [lsort $allatts]} attrs] || \
  931.     ![string length $attrs]} {return}
  932.     
  933.     set newlines ""
  934.     foreach line [lrange [split $additions "\n"] 1 end] {
  935.         set command [lindex $line 1]
  936.         if {[lindex $line 0] != $element} {
  937.             append newlines "$line\n"
  938.         } else {
  939.             set var [lindex $command 1]
  940.             # Remove from URL, Color and Window lists.
  941.             foreach ucw [list URL Color Window] {
  942.                 if {$var == "html${ucw}Attr"} {
  943.                     if {[lsearch -exact $attrs [string trimright [lindex $command 2] =]] >= 0} {
  944.                         lappend ${ucw}maybe [lindex $command 2]
  945.                         set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  946.                         set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  947.                     } else {
  948.                         append newlines "$line\n"
  949.                     }
  950.                 }
  951.                 if {$var == "htmlSpec${ucw}"} {
  952.                     set tmpadd [lrange $command 2 end]
  953.                     foreach c $tmpadd {
  954.                         regexp {[^!=]+!?=(.*)} $c dum tmp
  955.                         if {[lsearch -exact $attrs $tmp] >= 0} {
  956.                             set where [lsearch -exact [set htmlSpec${ucw}] $c]
  957.                             set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  958.                             set where [lsearch -exact $tmpadd $c]
  959.                             set tmpadd [lreplace $tmpadd $where $where]
  960.                         }
  961.                     }
  962.                     if {[llength $tmpadd]} {append newlines "[list $element] \{lappend htmlSpec${ucw} $tmpadd\}\n"} 
  963.                 }
  964.             } 
  965.             if {[lsearch {htmlURLAttr htmlColorAttr htmlWindowAttr htmlSpecURL htmlSpecColor htmlSpecWindow htmlPlugins} $var] < 0 && \
  966.             ![string match "htmlElemKeyBinding*" $var] && ![string match "htmlElemProc*" $var]} {
  967.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  968.                 set added [string trimleft [string trimright $added \}] \{]
  969.                 foreach c $added {
  970.                     regexp {[^=]+} $c tmp
  971.                     if {[lsearch -exact $attrs $tmp] >= 0} {
  972.                         set where [lsearch -exact [set ${var}($element)] $c]
  973.                         set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  974.                         set where [lsearch -exact $added $c]
  975.                         set added [lreplace $added $where $where]
  976.                     }
  977.                 }
  978.                 if {[llength $added] || ([lindex $command 0] == "set" && $var == "htmlElemAttrOptional1")} {
  979.                     if {[lindex $command 0] == "set"} {set added [list $added]}
  980.                     append newlines "[list $element] \{[lindex $command 0] ${var}($arg) $added\}\n"
  981.                 }
  982.             }
  983.             if {[string match "htmlElemKeyBinding*" $var] || [string match "htmlElemProc*" $var]} {
  984.                 append newlines "$line\n"
  985.             }
  986.         }
  987.     }
  988.     # Unset empty lists.
  989.     foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  990.         if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  991.             unset html${c}1($element)
  992.         }
  993.     }
  994.     # URL, Color or Window attributes just removed
  995.     # should be replaced if they are used by some other element.
  996.     foreach ucw [list URL Color Window] {
  997.         if {[info exists ${ucw}maybe]} {
  998.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  999.         }
  1000.     }
  1001.     if {[string length $newlines]} {
  1002.         set fid [open $PREFS:HTMLadditions.tcl w]
  1003.         puts -nonewline $fid "$htmlVersion\n$newlines"
  1004.         close $fid
  1005.     } else {
  1006.         removeFile $PREFS:HTMLadditions.tcl
  1007.         set htmlAdditionExist 0
  1008.     }
  1009.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  1010.     message "Attributes removed from $element."
  1011. }
  1012.  
  1013.  
  1014. #===============================================================================
  1015. #  Home pages
  1016. #===============================================================================
  1017.  
  1018. # Dialog to handle servers and corresponding home page folders.
  1019. proc htmlHomePages {{this ""}} {
  1020.     global modifiedModeVars HTMLmodeVars
  1021.     
  1022.     set pages $HTMLmodeVars(homePages)
  1023.     set servers $HTMLmodeVars(FTPservers)
  1024.     set touchedIt 0
  1025.     if {$this == ""} {set this ∞}
  1026.     while {1} {
  1027.         set box "-t {Home pages} 180 10 300 30 -t {Server URLs:} 10 40 100 60 \
  1028.         -t {Home Page Folder:} 10 70 110 110 \
  1029.         -t {Include Folder:} 10 120 110 140 -t {Default file:} 10 170 100 190 \
  1030.         -t {Ftp server:} 10 200 100 220 -t {User ID:} 10 225 100 245 \
  1031.         -t Password: 10 250 100 270 -t Directory: 10 275 100 295 \
  1032.         -b OK 10 330 75 350 -b Cancel 90 330 155 350 -b New… 170 330 235 350 \
  1033.         -c {Tell Big Brother} 0 320 300 440 320"
  1034.         if {[llength $pages]} {
  1035.             set pgs ""
  1036.             foreach pg $pages {
  1037.                 lappend pgs "[lindex $pg 1][lindex $pg 2]"
  1038.             }
  1039.             append box " -m [list [concat $this $pgs]] 110 40 440 60"
  1040.             append box " -b Change… 250 330 320 350 -b Remove 335 330 400 350"
  1041.             foreach pg $pages {
  1042.                 lappend box -n "[lindex $pg 1][lindex $pg 2]" -t [lindex $pg 0] 120 70 440 110 \
  1043.                 -t [lindex $pg 3] 110 170 310 190
  1044.                 if {[llength $pg] == 5} {lappend box -t [lindex $pg 4] 120 120 440 160}
  1045.                 foreach f $servers {
  1046.                     if {[lindex $f 0] == [lindex $pg 0]} {
  1047.                         lappend box -t [lindex $f 1] 120 200 440 220 \
  1048.                         -t [lindex $f 2] 120 225 440 245
  1049.                         set pwb ""
  1050.                         for {set i 0} {$i < [string length [lindex $f 3]]} {incr i} {
  1051.                             append pwb •
  1052.                         }
  1053.                         lappend box -t $pwb 120 250 440 270 \
  1054.                         -t [lindex $f 4] 120 275 440 295
  1055.                     }
  1056.                 }
  1057.             }
  1058.         } else {
  1059.             append box  " -m {{None defined} {None defined}} 110 40 440 60"
  1060.         }
  1061.         set values [eval [concat dialog -w 450 -h 360 $box]]
  1062.         set this [lindex $values 4]
  1063.         if {[lindex $values 0]} {
  1064.             set HTMLmodeVars(homePages) $pages
  1065.             set HTMLmodeVars(FTPservers) $servers
  1066.             lappend modifiedModeVars {homePages HTMLmodeVars} {FTPservers HTMLmodeVars}
  1067.             if {[lindex $values 3]} {
  1068.                 if {[htmlGetVersion Bbth] < 1.1} {
  1069.                     alertnote "Cannot change the settings in Big Brother. You need Big Brother 1.1 or later."
  1070.                 } elseif {[askyesno "Change URL mappings in Big Brother?"] == "yes"} {
  1071.                     if {![app::isRunning Bbth] && [catch {app::launchBack Bbth}]} {
  1072.                         alertnote "Could not find or launch Big Brother."
  1073.                         return
  1074.                     }
  1075.                     set urlmap [htmlURLmap]
  1076.                     AEBuild 'Bbth' core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[$urlmap\]"
  1077.                 }
  1078.             }
  1079.             return
  1080.         } elseif {[lindex $values 1]} {
  1081.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1082.         } elseif {[lindex $values 2]} {
  1083.             set newpg {{} {} {} "index.html" {}}
  1084.             set newserver {{} {} {} {}}
  1085.             while {1} {
  1086.                 if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4]} newpg]} {break}
  1087.                 if {[htmlTestHomePage $pages $newpg]} {
  1088.                     lappend pages $newpg
  1089.                     if {[lindex $newserver 0] != ""} {lappend servers [concat [list [lindex $newpg 0]] $newserver]}
  1090.                     set this "[lindex $newpg 1][lindex $newpg 2]"
  1091.                     set touchedIt 1
  1092.                     break
  1093.                 }
  1094.             }
  1095.         } else {
  1096.             for {set i 0} {$i < [llength $pages]} {incr i} {
  1097.                 if {"[lindex [lindex $pages $i] 1][lindex [lindex $pages $i] 2]" == $this} {
  1098.                     if {[lindex $values 5]} {
  1099.                         set newpg [lindex $pages $i]
  1100.                         set pg "[lindex $newpg 1][lindex $newpg 2]"
  1101.                         set oldpage [lindex $newpg 0]
  1102.                         set newserver {{} {} {} {}}
  1103.                         foreach f $servers {
  1104.                             if {[lindex $f 0] == $oldpage} {set newserver [lrange $f 1 end]}
  1105.                         }
  1106.                         while {1} {
  1107.                             if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4] $pg} newpg]} {break}
  1108.                             if {[htmlTestHomePage $pages $newpg $pg]} {
  1109.                                 set pages [lreplace $pages $i $i $newpg]
  1110.                                 set ns ""
  1111.                                 foreach f $servers {
  1112.                                     if {[lindex $f 0] != $oldpage} {lappend ns $f}
  1113.                                 }
  1114.                                 set servers $ns
  1115.                                 if {[lindex $newserver 0] != ""} {lappend servers [concat [list [lindex $newpg 0]] $newserver]}
  1116.                                 set this "[lindex $newpg 1][lindex $newpg 2]"
  1117.                                 set touchedIt 1
  1118.                                 break
  1119.                             }
  1120.                         }
  1121.                     } else {
  1122.                         set tpg [lindex [lindex $pages $i] 0]
  1123.                         set ns ""
  1124.                         foreach f $servers {
  1125.                             if {[lindex $f 0] != $tpg} {lappend ns $f}
  1126.                         }
  1127.                         set servers $ns
  1128.                         set pages [lreplace $pages $i $i]
  1129.                         set touchedIt 1
  1130.                     }
  1131.                 }
  1132.             }
  1133.         }
  1134.     }
  1135. }
  1136.  
  1137. # Dialog to define or change a home page.
  1138. proc htmlSetHomePages {pages folder url defFile inclFld {pg ""}} {
  1139.     upvar newserver server
  1140.     while {1} {
  1141.         set pwb ""
  1142.         for {set i 0} {$i < [string length [lindex $server 2]]} {incr i} {
  1143.             append pwb •
  1144.         }
  1145.         set val [dialog -w 450 -h 320 -t "Home Page Folder:" 10 10 135 30 -t $folder 140 10 440 50 \
  1146.         -t "Include Folder:" 10 60 110 80 -t $inclFld 130 60 440 100 \
  1147.         -t "Server URL:" 10 110 90 130 \
  1148.         -e $url 100 110 440 125 -t "Default file:" 10 145 90 160 \
  1149.         -e $defFile 100 145 440 160 \
  1150.         -t "Ftp Server:" 10 180 90 200 -e [lindex $server 0] 100 180 440 195 \
  1151.         -t "User ID:" 10 205 90 225 -e [lindex $server 1] 100 205 440 220 \
  1152.         -t "Password:" 10 230 85 250 -t $pwb 160 230 440 245 \
  1153.         -t "Directory:" 10 260 90 280 -e [lindex $server 3] 100 260 440 275 \
  1154.         -b OK 20 290 85 310 -b Cancel 110 290 175 310  -b Set… 90 230 150 250 \
  1155.         -b "Set…" 20 30 80 50 -b "Set…" 10 80 60 100 -b "Unset" 70 80 120 100]
  1156.         set url [string trim [lindex $val 0]]
  1157.         set defFile [string trim [lindex $val 1]]
  1158.         set ftp [string trim [lindex $val 2]]
  1159.         regexp {^(ftp://)?(.*)$} $ftp dum1 dum2 ftp
  1160.         set dir [string trimright [string trim [lindex $val 4]] /]
  1161.         if {[lindex $val 7] && ![catch {htmlGetPassword $ftp} newpw]} {
  1162.             set pw $newpw
  1163.         } else {
  1164.             set pw [lindex $server 2]
  1165.         }
  1166.         set server [list $ftp [string trim [lindex $val 3]] \
  1167.         $pw $dir]
  1168.         if {[lindex $val 8] && ![catch {htmlGetAhpFolder "Home Page Folder:" $pages $pg} fld]} {
  1169.             set folder $fld
  1170.         } elseif {[lindex $val 9] && ![catch {htmlGetAhpFolder "Include Folder:" $pages $pg} fld]} {
  1171.             set inclFld $fld
  1172.         } elseif {[lindex $val 10]} {
  1173.             set inclFld ""
  1174.         } elseif {[lindex $val 5]} {
  1175.             if {![regexp {://} $url] && $url != ""} {
  1176.                 alertnote "The server URL can't be a relative URL."
  1177.             } elseif {[lindex $server 0] != "" && [lindex $server 1] == ""} {
  1178.                 alertnote "When you specify an ftp server you must give the user ID."
  1179.             } elseif {$folder == $inclFld} {
  1180.                 alertnote "The home page folder and include folder can't be the same folder."
  1181.             } elseif {[string length $folder] && [string length $url] && [string length $defFile]} {
  1182.                 regexp -indices {://} $url css
  1183.                 set sl [string first / [string range $url [expr [lindex $css 1] + 1] end]]
  1184.                 if {$sl < 0} {
  1185.                     set base "$url/"
  1186.                     set path ""
  1187.                 } elseif {[string index $url [expr [string length $url] -1]] != "/"} {
  1188.                     alertnote "A directory URL ending with a slash expected."
  1189.                     continue
  1190.                 } else {
  1191.                     set base [string range $url 0 [expr [lindex $css 1] + $sl + 1]]
  1192.                     set path [string range $url [expr [lindex $css 1] + $sl + 2] end]
  1193.                 }
  1194.                 set ret [list $folder $base $path $defFile]
  1195.                 if {$inclFld != ""} {lappend ret $inclFld}
  1196.                 return  $ret
  1197.             } else {
  1198.                 alertnote "Home page folder, server URL, and default file must be specified."
  1199.             }
  1200.         } elseif {[lindex $val 6]} {
  1201.             error ""
  1202.         }
  1203.     }
  1204. }
  1205.  
  1206. proc htmlTestHomePage {pages newpg {pg ""}} {
  1207.     foreach p $pages {
  1208.         if {"[lindex $p 1][lindex $p 2]" == $pg} {continue}
  1209.         if {[string match "[lindex $p 1][lindex $p 2]*" "[lindex $newpg 1][lindex $newpg 2]"] ||
  1210.         [string match "[lindex $newpg 1][lindex $newpg 2]*" "[lindex $p 1][lindex $p 2]"]} {
  1211.             alertnote "There is already a home page folder for [lindex $p 1][lindex $p 2].\
  1212.             It overlaps with this one."
  1213.             return 0
  1214.         }
  1215.     }
  1216.     return 1
  1217. }    
  1218.  
  1219. proc htmlGetAhpFolder {txt pages pg} {
  1220.     set fld [htmlGetDir $txt]
  1221.     set msg {"home page" "" "" "" include}
  1222.     foreach p $pages {
  1223.         foreach i {0 4} {
  1224.             if {"[lindex $p 1][lindex $p 2]" == $pg && [regexp -nocase [lindex $msg $i] $txt]
  1225.             || [llength $p] == $i} {continue}
  1226.             if {[string match "[lindex $p $i]:*" "$fld:"] || [string match "$fld:*" "[lindex $p $i]:"]} {
  1227.                 alertnote "This folder overlaps with the [lindex $msg $i] folder for [lindex $p 1][lindex $p 2]."
  1228.                 error ""
  1229.             }
  1230.         }
  1231.     }
  1232.     return $fld
  1233. }
  1234.  
  1235.